Import de bibliotecas:
library(tidyverse)
library(lubridate)
library(scales)
library(plotly)
library(forecast)
library(Metrics)
library(prophet)
theme_set(theme_gray())
Leitura do data-frame. Alguns valores de “;” causaram algum problema para abrir e foram substituidos por “:”. Os valores de “data_safra” são lidos como datas. Os valores ausentes (NA) no faturamento são imputados como zero (0).
df <- read.csv2(text=str_replace_all(readLines("base_case.csv", skip=1), "; ", ": ")) %>%
mutate(data_safra = as.Date(data_safra)) %>%
mutate(valor_faturamento = replace_na(valor_faturamento, 0)) %>%
mutate(codigo_empresa = as.factor(codigo_empresa)) # Faz com que o código da empresa possa ser analisado como categoria posteriormente
Sumário de valores iniciais do data-frame.
summary(df)
p <- df %>%
group_by(data_safra) %>%
summarize(valor_faturamento=sum(valor_faturamento)) %>%
ggplot(aes(x=data_safra, y=valor_faturamento)) +
geom_line(size=1) +
scale_y_continuous(labels = dollar_format()) +
scale_x_date(date_breaks = "3 month", labels = date_format("%m-%Y")) +
labs(x = "Data", y = "Faturamento") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
ggplotly(p)
Ajuste linear para o faturamento para verificar a tendência e correlação.
p <- df %>%
group_by(data_safra) %>%
summarize(valor_faturamento=sum(valor_faturamento)) %>%
ggplot(aes(x=data_safra, y=valor_faturamento)) +
geom_line(size=0.4) +
geom_smooth(method = lm) +
scale_y_continuous(labels = dollar_format()) +
scale_x_date(date_breaks = "3 month", labels = date_format("%m-%Y")) +
labs(x = "Data", y = "Faturamento") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
ggplotly(p)
Dados do ajuste:
lin_model <- df %>%
group_by(data_safra) %>%
summarize(valor_faturamento=sum(valor_faturamento)) %>%
lm(formula = valor_faturamento ~ data_safra)
summary(lin_model)
##
## Call:
## lm(formula = valor_faturamento ~ data_safra, data = .)
##
## Residuals:
## Min 1Q Median 3Q Max
## -15636 -6218 394 4786 11405
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -1.161e+06 6.127e+04 -18.95 <2e-16 ***
## data_safra 8.135e+01 3.534e+00 23.02 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 6703 on 34 degrees of freedom
## Multiple R-squared: 0.9397, Adjusted R-squared: 0.9379
## F-statistic: 529.8 on 1 and 34 DF, p-value: < 2.2e-16
df %>%
group_by(st_idade_faixa) %>%
summarize(valor_faturamento=sum(valor_faturamento)) %>%
arrange(desc(valor_faturamento)) %>%
mutate(st_idade_faixa = fct_reorder(st_idade_faixa, valor_faturamento)) %>%
drop_na() %>%
ggplot(aes(st_idade_faixa, valor_faturamento, fill = st_idade_faixa)) +
geom_col() +
coord_flip() +
theme(legend.position = "none") +
labs(x="", y="Faturamento") +
scale_y_continuous(labels = dollar_format())
df %>%
group_by(st_idade_faixa) %>%
summarize(valor_faturamento=sum(valor_faturamento)) %>%
arrange(desc(valor_faturamento)) %>%
mutate(st_idade_faixa = fct_reorder(st_idade_faixa, valor_faturamento)) %>%
drop_na() %>%
view()
df %>%
group_by(st_funcionariosfaixa) %>%
summarize(valor_faturamento=sum(valor_faturamento)) %>%
arrange(desc(valor_faturamento)) %>%
mutate(st_funcionariosfaixa = fct_reorder(st_funcionariosfaixa, valor_faturamento)) %>%
drop_na() %>%
head(10) %>%
ggplot(aes(st_funcionariosfaixa, valor_faturamento, fill = st_funcionariosfaixa)) +
geom_col() +
coord_flip() +
theme(legend.position = "none") +
labs(x="", y="Faturamento") +
scale_y_continuous(labels = dollar_format())
df %>%
group_by(st_funcionariosfaixa) %>%
summarize(valor_faturamento=sum(valor_faturamento)) %>%
arrange(desc(valor_faturamento)) %>%
mutate(st_funcionariosfaixa = fct_reorder(st_funcionariosfaixa, valor_faturamento)) %>%
drop_na() %>%
head(10) %>%
view()
df %>%
group_by(st_mesorregiao) %>%
summarize(valor_faturamento=sum(valor_faturamento)) %>%
arrange(desc(valor_faturamento)) %>%
mutate(st_mesorregiao=fct_reorder(st_mesorregiao, valor_faturamento)) %>%
drop_na() %>%
head(5) %>%
ggplot(aes(st_mesorregiao, valor_faturamento, fill = st_mesorregiao)) +
geom_col() +
coord_flip() +
theme(legend.position = "none") +
labs(x="", y="Faturamento") +
scale_y_continuous(labels = dollar_format())
df %>%
group_by(st_mesorregiao) %>%
summarize(valor_faturamento=sum(valor_faturamento)) %>%
arrange(desc(valor_faturamento)) %>%
mutate(st_mesorregiao=fct_reorder(st_mesorregiao, valor_faturamento)) %>%
drop_na() %>%
head(5) %>%
view()
df %>%
group_by(st_microrregiao) %>%
summarize(valor_faturamento=sum(valor_faturamento)) %>%
arrange(desc(valor_faturamento)) %>%
mutate(st_microrregiao=fct_reorder(st_microrregiao, valor_faturamento)) %>%
drop_na() %>%
head(10) %>%
ggplot(aes(st_microrregiao, valor_faturamento, fill = st_microrregiao)) +
geom_col() +
coord_flip() +
theme(legend.position = "none") +
labs(x="", y="Faturamento") +
scale_y_continuous(labels = dollar_format())
df %>%
group_by(st_microrregiao) %>%
summarize(valor_faturamento=sum(valor_faturamento)) %>%
arrange(desc(valor_faturamento)) %>%
mutate(st_microrregiao=fct_reorder(st_microrregiao, valor_faturamento)) %>%
drop_na() %>%
head(10) %>%
view()
# CNAE: Classificação Nacional de Atividades Econômicas
df %>%
group_by(st_subclassecnae) %>%
summarize(valor_faturamento=sum(valor_faturamento)) %>%
arrange(desc(valor_faturamento)) %>%
mutate(st_subclassecnae=fct_reorder(st_subclassecnae, valor_faturamento)) %>%
drop_na() %>%
head(10) %>%
ggplot(aes(st_subclassecnae, valor_faturamento, fill = st_subclassecnae)) +
geom_col() +
coord_flip() +
theme(legend.position = "none") +
labs(x="", y="Faturamento") +
scale_y_continuous(labels = dollar_format())
df %>%
group_by(st_subclassecnae) %>%
summarize(valor_faturamento=sum(valor_faturamento)) %>%
arrange(desc(valor_faturamento)) %>%
mutate(st_subclassecnae=fct_reorder(st_subclassecnae, valor_faturamento)) %>%
drop_na() %>%
head(10) %>%
view()
df %>%
group_by(st_classecnae) %>%
summarize(valor_faturamento=sum(valor_faturamento)) %>%
arrange(desc(valor_faturamento)) %>%
mutate(st_classecnae=fct_reorder(st_classecnae, valor_faturamento)) %>%
drop_na() %>%
head(10) %>%
ggplot(aes(st_classecnae, valor_faturamento, fill = st_classecnae)) +
geom_col() +
coord_flip() +
theme(legend.position = "none") +
labs(x="", y="Faturamento") +
scale_y_continuous(labels = dollar_format())
df %>%
group_by(st_grupocnae) %>%
summarize(valor_faturamento=sum(valor_faturamento)) %>%
arrange(desc(valor_faturamento)) %>%
mutate(st_grupocnae=fct_reorder(st_grupocnae, valor_faturamento)) %>%
drop_na() %>%
head(10) %>%
ggplot(aes(st_grupocnae, valor_faturamento, fill = st_grupocnae)) +
geom_col() +
coord_flip() +
theme(legend.position = "none") +
labs(x="", y="Faturamento") +
scale_y_continuous(labels = dollar_format())
df %>%
group_by(st_divisaocnae) %>%
summarize(valor_faturamento=sum(valor_faturamento)) %>%
arrange(desc(valor_faturamento)) %>%
mutate(st_divisaocnae=fct_reorder(st_divisaocnae, valor_faturamento)) %>%
drop_na() %>%
head(10) %>%
ggplot(aes(st_divisaocnae, valor_faturamento, fill = st_divisaocnae)) +
geom_col() +
coord_flip() +
theme(legend.position = "none") +
labs(x="", y="Faturamento") +
scale_y_continuous(labels = dollar_format())
df %>%
group_by(codigo_empresa) %>%
summarize(valor_faturamento=sum(valor_faturamento), cat = unique(st_divisaocnae)) %>%
arrange(desc(valor_faturamento)) %>%
mutate(codigo_empresa=fct_reorder(codigo_empresa, valor_faturamento)) %>%
# drop_na() %>%
head(10) %>%
ggplot(aes(codigo_empresa, valor_faturamento, fill = cat)) +
geom_col() +
coord_flip() +
labs(x="", y="Faturamento") +
scale_y_continuous(labels = dollar_format()) +
theme(legend.position="bottom") +
guides(fill=guide_legend(nrow=5, byrow=TRUE))
df %>%
group_by(codigo_empresa) %>%
summarize(valor_faturamento=sum(valor_faturamento), cat = unique(st_divisaocnae)) %>%
arrange(desc(valor_faturamento)) %>%
mutate(codigo_empresa=fct_reorder(codigo_empresa, valor_faturamento)) %>%
# drop_na() %>%
head(10) %>%
view()
df3 <- df %>%
group_by(data_safra) %>%
summarize(valor_faturamento=sum(valor_faturamento))
train <- df3[1:28,]
test <- df3[29:36,]
test_ts <- test %>%
rename(ds = data_safra, y = valor_faturamento) %>%
subset(select = -c(y) )
train_ts <- train %>%
rename(ds = data_safra, y = valor_faturamento)
model_arima <- auto.arima(train$valor_faturamento)
model_tbats <- tbats(train$valor_faturamento)
model_ets <- ets(train$valor_faturamento)
model_prophet <- prophet(train_ts)
f_arima <- forecast(model_arima, h=8)
f_tbats <- forecast(model_tbats, h=8)
f_ets <- forecast(model_ets, h=8)
f_naive <- naive(train$valor_faturamento, h=8)
f_meanf <- meanf(train$valor_faturamento, h=8)
f_rwf <- rwf(train$valor_faturamento, h=8)
# f_croston <- croston(train$valor_faturamento, h=8)
f_ses <- ses(train$valor_faturamento, h=8)
f_holt <- holt(train$valor_faturamento, h=8)
f_splinef <- splinef(train$valor_faturamento, h=8)
f_thetaf <- thetaf(train$valor_faturamento, h=8)
f_prophet <- predict(model_prophet, test_ts)
print(mae(test$valor_faturamento, f_arima$mean))
## [1] 4972.11
print(mae(test$valor_faturamento, f_tbats$mean))
## [1] 5502.643
print(mae(test$valor_faturamento, f_ets$mean))
## [1] 8891.716
print(mae(test$valor_faturamento, f_naive$mean))
## [1] 13025.21
print(mae(test$valor_faturamento, f_meanf$mean))
## [1] 47447.46
print(mae(test$valor_faturamento, f_rwf$mean))
## [1] 13025.21
# print(mae(test$valor_fatura4mento, f_croston$mean))
print(mae(test$valor_faturamento, f_ses$mean))
## [1] 16404.61
print(mae(test$valor_faturamento, f_holt$mean))
## [1] 8388.042
print(mae(test$valor_faturamento, f_splinef$mean))
## [1] 7270.132
print(mae(test$valor_faturamento, f_thetaf$mean))
## [1] 10908.08
print(mae(test$valor_faturamento, f_prophet$yhat))
## [1] 15862.43
df4 <- df %>%
group_by(data_safra) %>%
summarize(valor_faturamento=sum(valor_faturamento))
model2 <- bats(df4$valor_faturamento)
f2 <- forecast(model2, h=12)
dates <- rep(seq(as.Date('2019-01-01'), as.Date('2019-12-1'), by = 'months'), times = 1)
fcast <- data_frame("data_safra"=dates, "f_mean"=f2$mean,
"f_upper" = f2$upper[,2], "f_lower" = f2$lower[,2])
p <- ggplot(df4, aes(x=data_safra, y=valor_faturamento)) +
geom_line(size=1) +
geom_line(data=df4, aes(x=data_safra, y=valor_faturamento)) +
geom_line(data=fcast, aes(x=data_safra, y=f_mean, color="Forecast")) +
geom_line(data=fcast, aes(x=data_safra, y=f_lower, color="Lower"), linetype = "dotted") +
geom_line(data=fcast, aes(x=data_safra, y=f_upper, color="Upper"), linetype = "dotted") +
geom_smooth(data=df4, aes(x=data_safra, y=valor_faturamento),method = lm) +
labs(x="Data", y="Faturamento") +
scale_y_continuous(labels = dollar_format())
ggplotly(p)
#acf(model$residuals)
df4 <- df %>%
group_by(data_safra) %>%
summarize(valor_faturamento=sum(valor_faturamento))
model2 <- auto.arima(df4$valor_faturamento)
f2 <- forecast(model2, h=12)
dates <- rep(seq(as.Date('2019-01-01'), as.Date('2019-12-1'), by = 'months'), times = 1)
fcast <- data_frame("data_safra"=dates, "f_mean"=f2$mean,
"f_upper" = f2$upper[,2], "f_lower" = f2$lower[,2])
p <- ggplot(df4, aes(x=data_safra, y=valor_faturamento)) +
geom_line(size=1) +
geom_line(data=df4, aes(x=data_safra, y=valor_faturamento)) +
geom_line(data=fcast, aes(x=data_safra, y=f_mean, color="Forecast")) +
geom_line(data=fcast, aes(x=data_safra, y=f_lower, color="Lower"), linetype = "dotted") +
geom_line(data=fcast, aes(x=data_safra, y=f_upper, color="Upper"), linetype = "dotted") +
labs(x="Data", y="Faturamento") +
scale_y_continuous(labels = dollar_format())
ggplotly(p)
df4 <- df %>%
group_by(data_safra) %>%
summarize(valor_faturamento=sum(valor_faturamento)) %>%
rename(ds = data_safra, y = valor_faturamento)
model2 <- prophet(df4)
dates <- rep(seq(as.Date('2019-01-01'), as.Date('2019-12-1'), by = 'months'), times = 1)
ts <- data_frame("ds"=dates)
f2 <- predict(model2, ts)
fcast <- data_frame("data_safra"=dates, "f_mean"=f2$yhat,
"f_upper" = f2$yhat_upper, "f_lower" = f2$yhat_lower)
p <- ggplot(df4, aes(x=ds, y=y)) +
geom_line(size=1) +
geom_line(data=fcast, aes(x=data_safra, y=f_mean, color="Forecast")) +
geom_line(data=fcast, aes(x=data_safra, y=f_lower, color="Lower"), linetype = "dotted") +
geom_line(data=fcast, aes(x=data_safra, y=f_upper, color="Upper"), linetype = "dotted") +
labs(x="Data", y="Faturamento") +
scale_y_continuous(labels = dollar_format())
ggplotly(p)